home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / tpdate.zip / DATE.PAS < prev    next >
Pascal/Delphi Source File  |  1992-06-25  |  31KB  |  627 lines
  1. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  2. {▐                   ╔══════════════════════════════════╗                   ▌}
  3. {▐                   ║             D A T E              ║                   ▌}
  4. {▐                   ║              V 1.5               ║                   ▌}
  5. {▐                   ║         David Gegenheimer        ║                   ▌}
  6. {▐                   ╠══════════════════════════════════╣                   ▌}
  7. {▐                   ║  Last Change Made  :  06/25/1992 ║                   ▌}
  8. {▐                   ╚══════════════════════════════════╝                   ▌}
  9. {▐══════════════════════════════════════════════════════════════════════════▌}
  10. {▐ This unit is given freely, as is.  The author will not, and should not   ▌}
  11. {▐ be held responsible for any damages incurred by its use/misuse.  The     ▌}
  12. {▐ use of this unit should happen only after the user has examined its code ▌}
  13. {▐ and found that it meets his/her satisfaction.  The author would really   ▌}
  14. {▐ appreciate hearing about any bugs in this unit that are found.  However, ▌}
  15. {▐ this unit cannot be modified and re-destributed by anyone except David   ▌}
  16. {▐ Gegenheimer.  The reason being for this is mainly to protect myself. If  ▌}
  17. {▐ someone modifies the code for the worse, and sends it out - I get the    ▌}
  18. {▐ blame!.                                                                  ▌}
  19. {▐ On the brighter side!   This code is free!  Please Send no Money!        ▌}
  20. {▐                    Use it in any program you like!                       ▌}
  21. {▐                                                                          ▌}
  22. {▐ If you have found any bugs, please write me at the following address, &  ▌}
  23. {▐ tell me the bug, and what BBS you downloaded it from  so that I can send ▌}
  24. {▐ them an update! THANK YOU!                                               ▌}
  25. {▐                                                                          ▌}
  26. {▐                           David Gegenheimer                              ▌}
  27. {▐                           600 Clayton Dr.                                ▌}
  28. {▐                           Houma, La. 70364                               ▌}
  29. {▐                                                                          ▌}
  30. {▐ This unit allows for easy date manipulation via Julian Date conversion.  ▌}
  31. {▐ The routines and their parameters are as follows:                        ▌}
  32. {▐                                                                          ▌}
  33. {▐  Function  JulianDate (Day,Month,Year)                                   ▌}
  34. {▐          - Send it 3 Integers                                            ▌}
  35. {▐          - Returns a variable of type JDate                              ▌}
  36. {▐          - Ex. AJDate := JulianDate (1,1,1992); (AJDate = 2448622)       ▌}
  37. {▐                                                                          ▌}
  38. {▐  Procedure CalendarDate (AJDate,Day,Month,Year)                          ▌}
  39. {▐          - Send it a Julian Date, and 3 Integers                         ▌}
  40. {▐          - Returns the Day,Month, & Year contained in the Julian Date    ▌}
  41. {▐          - Ex. CalendarDate (2448622,Day,Month,Year); (1/1/92)           ▌}
  42. {▐                                                                          ▌}
  43. {▐  Function  DayOfTheWeek (AJDate)                                         ▌}
  44. {▐          - Send it a Julian Date                                         ▌}
  45. {▐          - Returns an integer representing the Day of the Week           ▌}
  46. {▐          - (1 = Sunday, 2 = Monday, ... 6 = Friday, 7 = Saturday)        ▌}
  47. {▐          - Ex. TheDayOfTheWeek := DayOfTheWeek (A_Julian_Date);          ▌}
  48. {▐                                                                          ▌}
  49. {▐  Function  MonthAbrv (Month,Full)                                        ▌}
  50. {▐          - Send it an Integer and a Boolean variable                     ▌}
  51. {▐          - Returns a String containing the month's name                  ▌}
  52. {▐          - If Full is TRUE then the full months name is returned         ▌}
  53. {▐          - If Full is FALSE then a 3 character abbreviation is returned  ▌}
  54. {▐          - Ex. Mnth_Name := MonthAbrv (1,True);  (Mnth_Name = 'January') ▌}
  55. {▐          - Ex. Mnth_Name := MonthAbrv (1,False); (Mnth_Name = 'Jan');    ▌}
  56. {▐                                                                          ▌}
  57. {▐  Function  ValidDate (Day,Month,Year)                                    ▌}
  58. {▐          - Send it 3 Integers                                            ▌}
  59. {▐          - Returns TRUE if a valid date or FALSE if an Invalid date      ▌}
  60. {▐          - Ex. GoodDate := ValidDate (2,31,1992); (GoodDate = False)     ▌}
  61. {▐          - Ex. GoodDate := ValidDate (1,30,1992); (GoodDate = True)      ▌}
  62. {▐                                                                          ▌}
  63. {▐  Procedure DrawCalendar (X,Y,Day,Month,Year,TopColor,BotColor,HiColor);  ▌}
  64. {▐          - Send it 6 Integers                                            ▌}
  65. {▐          - X,Y is the Upperleft corner of the calendar to be printed     ▌}
  66. {▐          - Day if not 0 will be Hilighted on the calendar;               ▌}
  67. {▐          - Month and Year describe the contents of the calendar          ▌}
  68. {▐          - TopColor is in the format: BackGround*16+ForeGround           ▌}
  69. {▐          - BotColor is in the format: BackGround*16+ForeGround           ▌}
  70. {▐          - HiColor  is in the format: BackGround*16+ForeGround           ▌}
  71. {▐          - Ex. DrawCalendar (35,10,1,1,1992,Red*16+Yellow,Blue*16+White) ▌}
  72. {▐          - Result is:       January , 1992      <-- Yellow on Red        ▌}
  73. {▐                          Su  M  T  W  H  F Sa   <-- Yellow on Red        ▌}
  74. {▐                                    1  2  3  4   <-- White on Blue        ▌}
  75. {▐                           5  6  7  8  9 10 11            .               ▌}
  76. {▐                          12 13 14 15 16 17 18            .               ▌}
  77. {▐                          19 20 21 22 23 24 25            .               ▌}
  78. {▐                          26 27 28 29 30 31      <-- White on Blue        ▌}
  79. {▐            Note: This Chart appears at X = 35, Y= 10                     ▌}
  80. {▐                                                                          ▌}
  81. {▐  Procedure DateToStr                                                     ▌}
  82. {▐            - Real Simple, send it the date, and tell it how you want it  ▌}
  83. {▐                                                                          ▌}
  84. {▐  Procedure StrToDate                                                     ▌}
  85. {▐            - The reverse of DateToStr                                    ▌}
  86. {▐                                                                          ▌}
  87. {▐  Function  DateToday                                                     ▌}
  88. {▐            - Returns a ten character string containing todays date.      ▌}
  89. {▐                                                                          ▌}
  90. {▐  Function  SDateCompare                                                  ▌}
  91. {▐            - Send it two string dates.                                   ▌}
  92. {▐            - It returns   -1 if Date1 is Before Date2                    ▌}
  93. {▐                            0 if Date1 is Date2                           ▌}
  94. {▐                            1 If Date1 is After  Date2                    ▌}
  95. {▐                                                                          ▌}
  96. {▐  Function  SDateDiff                                                     ▌}
  97. {▐            - Send it two string dates.                                   ▌}
  98. {▐            - It returns the difference in days between date1 and date2   ▌}
  99. {▐            - Note: The calculation is performed:  Date1 - Date2.         ▌}
  100. {▐                                                                          ▌}
  101. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  102. Unit Date;
  103.  
  104. Interface
  105.  
  106. Uses Crt,Dos;
  107.  
  108. Type  JDate = LongInt;
  109.  
  110. Const _MMDDYY = 1;  {█ Date String Format - Month,Day,Year █}
  111.       _DDMMYY = 2;  {█ Date String Format - Day,Month,Year █}
  112.       _YYMMDD = 3;  {█ Date String Format - Year,Month,Day █}
  113.       _YYDDMM = 4;  {█ Date String Format - Year,Day,Month █}
  114.       _DDYYMM = 5;  {█ Date String Format - Day,Year,Month █}
  115.       _MMYYDD = 6;  {█ Date String Format - Month,Year,Day █}
  116.  
  117. Function  JulianDate   (    Day           : Integer;
  118.                             Month         : Integer;
  119.                             Year          : Integer)  : JDate;
  120.  
  121. Procedure CalendarDate (    AJDate        : JDate;
  122.                         Var Day,
  123.                             Month,
  124.                             Year          : Integer);
  125.  
  126. Function  DayOfTheWeek (    AJDate        : JDate)    : Integer;
  127.  
  128. Function  MonthAbrv    (    Month         : Integer;
  129.                             Full          : Boolean)  : String;
  130.  
  131. Function  ValidDate    (    Day           : Integer;
  132.                             Month         : Integer;
  133.                             Year          : Integer) : Boolean;
  134.  
  135. Procedure DrawCalendar (    X,Y           : Integer;
  136.                             Day           : Integer;
  137.                             Month         : Integer;
  138.                             Year          : Integer;
  139.                             TopColor      : Integer;
  140.                             BotColor      : Integer;
  141.                             HiColor       : Integer);
  142.  
  143. Procedure DateToStr    (    Day           : Integer;
  144.                             Month         : Integer;
  145.                             Year          : Integer;
  146.                         Var DateStr       : String;
  147.                             LeadingZeros  : Boolean;
  148.                             TwoDigitYear  : Boolean;
  149.                             Divider       : Char;
  150.                             Format        : Integer);
  151.  
  152. Procedure StrToDate    (    DateStr       : String;
  153.                         Var Day,
  154.                             Month,
  155.                             Year          : Integer;
  156.                             Format        : Integer);
  157.  
  158. Procedure StrToJDate   (    DateStr       : String;
  159.                         Var AJDate        : JDate;
  160.                             Format        : Integer;
  161.                             TwoDigitYear  : Boolean);
  162. Function  DateToday                                  : String;
  163. Function  SDateCompare (    Date1         : String;
  164.                             Date2         : String;
  165.                             Format1       : Integer;
  166.                             Format2       : Integer;
  167.                             TwoDigitYear1 : Boolean;
  168.                             TwoDigitYear2 : Boolean) : Integer;
  169. Function  SDateDiff    (    Date1         : String;
  170.                             Date2         : String;
  171.                             Format1       : Integer;
  172.                             Format2       : Integer;
  173.                             TwoDigitYear1 : Boolean;
  174.                             TwoDigitYear2 : Boolean) : LongInt;
  175.  
  176. Implementation
  177.  
  178. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  179. {▐                   ╔══════════════════════════════════╗                   ▌}
  180. {▐                   ║        J u l i a n D a t e       ║                   ▌}
  181. {▐                   ╚══════════════════════════════════╝                   ▌}
  182. {▐══════════════════════════════════════════════════════════════════════════▌}
  183. {▐ This function calculates and returns a julian date given Day,Month,Year. ▌}
  184. {▐ Note: If you send it an invalid date, such as 2/29/91 it will correct it ▌}
  185. {▐       as 3/1/91.  If this is a problem, check for ValidDate before.      ▌}
  186. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  187. Function JulianDate (Day,Month,Year : Integer) : JDate;
  188. Var A,B       : Integer;
  189.     Year_Corr : Real;
  190. Begin
  191.    B := 0;
  192.    If Month <= 2 Then
  193.       Begin
  194.          Dec (Year);
  195.          Inc (Month,12);
  196.       End;
  197.    If (Year * 10000.0 + Month * 100.0 + Day >= 15821015.0) Then
  198.       Begin
  199.          A := Year Div 100;
  200.          B := 2 - A + A Div 4;
  201.       End;
  202.    If Year > 0 Then
  203.       Year_Corr := 0.0
  204.    Else
  205.       Year_Corr := 0.75;
  206.    JulianDate := JDate (Trunc((365.25 * Year - Year_Corr)) +
  207.                         Trunc((30.6001 * (Month+1) + Day + 1720994 + B)));
  208. End;
  209. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  210.  
  211. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  212. {▐                   ╔══════════════════════════════════╗                   ▌}
  213. {▐                   ║     C a l e n d a r D a t e      ║                   ▌}
  214. {▐                   ╚══════════════════════════════════╝                   ▌}
  215. {▐══════════════════════════════════════════════════════════════════════════▌}
  216. {▐ This procedure is the opposite of JulianDate, it returns the Day,Month,  ▌}
  217. {▐ Year, given a Julian Date.                                               ▌}
  218. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  219. Procedure CalendarDate (AJDate : JDate; Var Day,Month,Year : Integer);
  220. Var A,B,C,D,E,Z,Alpha : LongInt;
  221. Begin
  222.    Z := AJDate + 1;
  223.    If (Z < 2299161) Then
  224.       A := Z
  225.    Else
  226.       Begin
  227.          Alpha := Trunc ((Z-1867216.25) / 36524.25);
  228.          A     := Z + 1 + Alpha - Alpha Div 4;
  229.       End;
  230.    B   := A + 1524;
  231.    C   := Trunc ((B - 122.1) / 365.25);
  232.    D   := Trunc (365.25 * C);
  233.    E   := Trunc ((B - D) / 30.6001);
  234.    Day := B - D - Trunc (30.6001 * E);
  235.    If E < 13.5 Then
  236.       Month := E - 1
  237.    Else
  238.       Month := E - 13;
  239.    If Month > 2.5 Then
  240.       Year := C - 4716
  241.    Else
  242.       Year := C - 4715;
  243. End;
  244. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  245.  
  246. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  247. {▐                   ╔══════════════════════════════════╗                   ▌}
  248. {▐                   ║      D a y O f T h e W e e k     ║                   ▌}
  249. {▐                   ╚══════════════════════════════════╝                   ▌}
  250. {▐══════════════════════════════════════════════════════════════════════════▌}
  251. {▐ This function, given a julian date, will return an integer in the range  ▌}
  252. {▐ (1-7) that represents a day of the week with sunday being 1 and saturday ▌}
  253. {▐ is 7.                                                                    ▌}
  254. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  255. Function DayOfTheWeek (AJDate : JDate) : Integer;
  256. Begin
  257.    DayOfTheWeek := Integer ((AJDate+2) Mod 7 + 1);
  258. End;
  259. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  260.  
  261. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  262. {▐                   ╔══════════════════════════════════╗                   ▌}
  263. {▐                   ║         V a l i d D a t e        ║                   ▌}
  264. {▐                   ╚══════════════════════════════════╝                   ▌}
  265. {▐══════════════════════════════════════════════════════════════════════════▌}
  266. {▐ This function, given a day, month, and Year (ex. 1,2,1992) will return   ▌}
  267. {▐ TRUE if that date is Valid, or FALSE if that date is Invalid.            ▌}
  268. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  269. Function ValidDate (Day,Month,Year : Integer) : Boolean;
  270. Var TempDay,TempMonth,TempYear : Integer;
  271.     TempJDate                  : JDate;
  272. Begin
  273.    TempJDate := JulianDate (Day,Month,Year);
  274.    CalendarDate (TempJDate,TempDay,TempMonth,TempYear);
  275.    If (Day = TempDay) And (Month = TempMonth) And (Year = TempYear) Then
  276.       ValidDate := True
  277.    Else
  278.       ValidDAte := False;
  279. End;
  280. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  281.  
  282. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  283. {▐                   ╔══════════════════════════════════╗                   ▌}
  284. {▐                   ║         M o n t h A b r v        ║                   ▌}
  285. {▐                   ╚══════════════════════════════════╝                   ▌}
  286. {▐══════════════════════════════════════════════════════════════════════════▌}
  287. {▐ This function, given an integer in the range (1-12) will return a string ▌}
  288. {▐ containing that months name.  If the integer sent is not a valid month,  ▌}
  289. {▐ then the string 'ERROR' is returned.  If full is true then the full name ▌}
  290. {▐ of the month is returned. If it is TRUE, then a 3 character abbreviation ▌}
  291. {▐ is returned.                                                             ▌}
  292. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  293. Function MonthAbrv (Month : Integer; Full : Boolean) : String;
  294. Var MonthStr : String [9];
  295. Begin
  296.    Case Month Of
  297.        1 : MonthStr := 'January';
  298.        2 : MonthStr := 'February';
  299.        3 : MonthStr := 'March';
  300.        4 : MonthStr := 'April';
  301.        5 : MonthStr := 'May';
  302.        6 : MonthStr := 'June';
  303.        7 : MonthStr := 'July';
  304.        8 : MonthStr := 'August';
  305.        9 : MonthStr := 'September';
  306.       10 : MonthStr := 'October';
  307.       11 : MonthStr := 'November';
  308.       12 : MonthStr := 'December';
  309.    End;
  310.    If Full Then
  311.       MonthAbrv := MonthStr
  312.    Else
  313.       MonthAbrv := Copy (MonthStr,1,3);
  314. End;
  315. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  316.  
  317. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  318. {▐                   ╔══════════════════════════════════╗                   ▌}
  319. {▐                   ║     D r a w C a l e n d a r      ║                   ▌}
  320. {▐                   ╚══════════════════════════════════╝                   ▌}
  321. {▐══════════════════════════════════════════════════════════════════════════▌}
  322. {▐ This procedure will draw a calendar of the given month & year at X,Y.    ▌}
  323. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  324. Procedure DrawCalendar (X,Y,Day,Month,Year,TopColor,BotColor,HiColor : Integer);
  325. Var AJDate : JDate;
  326.     Loop   : Integer;
  327.     Msg    : String;
  328.     Dow    : Integer;
  329. Begin
  330.    TextAttr := TopColor;
  331.    Str      (Year,Msg);
  332.    Msg      := MonthAbrv (Month,True)+' , '+Msg;
  333.    GotoXY (X,Y);
  334.    Write  ('                      ');
  335.    GotoXY (X+(11-(Length(Msg) Div 2)),Y);
  336.    Write  (Msg);
  337.    GotoXY (X,Y+1);
  338.    Write  (' Su  M  T  W  H  F Sa ');
  339.    Inc    (Y,2);
  340.    TextAttr := BotColor;
  341.    GotoXY (X,Y);
  342.    Write  ('                      ');
  343.    For Loop := 1 to 31 Do
  344.        Begin
  345.           AJDate := JulianDate (Loop,Month,Year);
  346.           Dow    := DayOfTheWeek(AJDate);
  347.           If Loop < 10 Then
  348.              GotoXY (X+Dow*3-1,Y)
  349.           Else
  350.              GotoXY (X+Dow*3-2,Y);
  351.           If ValidDate (Loop,Month,Year) Then
  352.              Begin
  353.                 If Loop = Day Then
  354.                    TextAttr := HiColor;
  355.                 Write (Loop);
  356.                 TextAttr := BotColor;
  357.              End;
  358.           If Dow Mod 7 = 0 Then
  359.              Begin
  360.                 Inc (Y);
  361.                 GotoXY (X,Y);
  362.                 Write ('                      ');
  363.              End;
  364.        End;
  365. End;
  366. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  367.  
  368. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  369. {▐                   ╔══════════════════════════════════╗                   ▌}
  370. {▐                   ║         D a t e T o S t r        ║                   ▌}
  371. {▐                   ╚══════════════════════════════════╝                   ▌}
  372. {▐══════════════════════════════════════════════════════════════════════════▌}
  373. {▐ This routine changes Day/Month/Year To A String.                         ▌}
  374. {▐ Its parameters are as follows:                                           ▌}
  375. {▐       Day,Month,Year ................... The Date to be converted        ▌}
  376. {▐       DateStr .......................... The resulting date string       ▌}
  377. {▐       LeadingZeros ..................... TRUE -- Dates are:  02/09/92    ▌}
  378. {▐                                          FALSE - Dates are:  2/9/92      ▌}
  379. {▐       TwoDigitYear ..................... TRUE -- Dates are  11/12/92     ▌}
  380. {▐                                          FALSE - Dates are  11/12/1992   ▌}
  381. {▐       Divider .......................... Any char ex. '/' -  5/6/92      ▌}
  382. {▐                                                       '-' -  5-6-92      ▌}
  383. {▐                                                       '■' -  5■6■92      ▌}
  384. {▐       Format ........................... The Way the date is organized   ▌}
  385. {▐                                          1) MM/DD/YY  4) YY/DD/MM        ▌}
  386. {▐                                          2) DD/MM/YY  5) DD/YY/MM        ▌}
  387. {▐                                          3) YY/MM/DD  6) MM/YY/DD        ▌}
  388. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  389. Procedure DateToStr (Day,Month,Year : Integer; Var DateStr  : String;
  390.                      LeadingZeros   : Boolean; TwoDigitYear : Boolean;
  391.                      Divider : Char;
  392.                      Format  : Integer);
  393. Var DStr : String [2];
  394.     MStr : String [2];
  395.     YStr : String [4];
  396. Begin
  397.    Str (Day  ,DStr);
  398.    Str (Month,MStr);
  399.    Str (Year ,YStr);
  400.    If LeadingZeros Then
  401.       Begin
  402.          If Day < 10 Then
  403.             DStr := '0'+DStr;
  404.          If Month < 10 Then
  405.             MStr := '0'+MStr;
  406.       End;
  407.    If TwoDigitYear Then
  408.       If Length (Ystr ) >= 4 Then
  409.          YStr := YStr [3] + YStr [4];
  410.    Case Format Of
  411.        _MMDDYY : DateStr := MStr + Divider + DStr + Divider + YStr;
  412.        _DDMMYY : DateStr := DStr + Divider + MStr + Divider + YStr;
  413.        _YYMMDD : DateStr := YStr + Divider + MStr + Divider + DStr;
  414.        _YYDDMM : DateStr := YStr + Divider + DStr + Divider + MStr;
  415.        _DDYYMM : DateStr := DStr + Divider + YStr + Divider + MStr;
  416.        _MMYYDD : DateStr := MStr + Divider + YStr + Divider + DStr;
  417.    End;
  418. End;
  419. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  420.  
  421. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  422. {▐                   ╔══════════════════════════════════╗                   ▌}
  423. {▐                   ║         S t r T o D a t e        ║                   ▌}
  424. {▐                   ╚══════════════════════════════════╝                   ▌}
  425. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  426. Procedure StrToDate (DateStr : String; Var Day,Month,Year : Integer; Format : Integer);
  427. Var Position : Integer;
  428.  
  429.     Function GetInt : Integer;
  430.     Var AnInt   : Integer;
  431.         TempStr : String;
  432.         Ret     : Integer;
  433.     Begin
  434.        TempStr := '';
  435.        While (Position <= Length (DateStr)) And
  436.              (DateStr [Position] In ['0','1','2','3','4','5','6','7','8','9']) Do
  437.           Begin
  438.              TempStr := TempStr + DateStr [Position];
  439.              Inc (Position);
  440.           End;
  441.        Val (TempStr,AnInt,Ret);
  442.        GetInt := AnInt;
  443.        Inc (Position);
  444.     End;
  445.  
  446. Begin
  447.    Position := 1;
  448.    Case Format Of
  449.        _MMDDYY : Begin
  450.                     Month := GetInt;
  451.                     Day   := GetInt;
  452.                     Year  := GetInt;
  453.                  End;
  454.        _DDMMYY : Begin
  455.                     Day   := GetInt;
  456.                     Month := GetInt;
  457.                     Year  := GetInt;
  458.                  End;
  459.        _YYMMDD : Begin
  460.                     Year  := GetInt;
  461.                     Month := GetInt;
  462.                     Day   := GetInt;
  463.                  End;
  464.        _YYDDMM : Begin
  465.                     Year  := GetInt;
  466.                     Day   := GetInt;
  467.                     Month := GetInt;
  468.                  End;
  469.        _DDYYMM : Begin
  470.                     Day   := GetInt;
  471.                     Year  := GetInt;
  472.                     Month := GetInt;
  473.                  End;
  474.        _MMYYDD : Begin
  475.                     Month := GetInt;
  476.                     Year  := GetInt;
  477.                     Day   := GetInt;
  478.                  End;
  479.    End;
  480. End;
  481. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  482.  
  483. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  484. {▐                   ╔══════════════════════════════════╗                   ▌}
  485. {▐                   ║        S t r T o J D a t e       ║                   ▌}
  486. {▐                   ╚══════════════════════════════════╝                   ▌}
  487. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  488. Procedure StrToJDate (DateStr : String; Var AJDate : JDate; Format : Integer;
  489.                       TwoDigitYear : Boolean);
  490. Var Position        : Integer;
  491.     Day,Month,Year  : Integer;
  492.     Function GetInt : Integer;
  493.     Var AnInt   : Integer;
  494.         TempStr : String;
  495.         Ret     : Integer;
  496.     Begin
  497.        TempStr := '';
  498.        While (Position <= Length (DateStr)) And
  499.              (DateStr [Position] In ['0','1','2','3','4','5','6','7','8','9']) Do
  500.           Begin
  501.              TempStr := TempStr + DateStr [Position];
  502.              Inc (Position);
  503.           End;
  504.        Val (TempStr,AnInt,Ret);
  505.        GetInt := AnInt;
  506.        Inc (Position);
  507.     End;
  508.  
  509. Begin
  510.    Position := 1;
  511.    Case Format Of
  512.        _MMDDYY : Begin
  513.                     Month := GetInt;
  514.                     Day   := GetInt;
  515.                     Year  := GetInt;
  516.                  End;
  517.        _DDMMYY : Begin
  518.                     Day   := GetInt;
  519.                     Month := GetInt;
  520.                     Year  := GetInt;
  521.                  End;
  522.        _YYMMDD : Begin
  523.                     Year  := GetInt;
  524.                     Month := GetInt;
  525.                     Day   := GetInt;
  526.                  End;
  527.        _YYDDMM : Begin
  528.                     Year  := GetInt;
  529.                     Day   := GetInt;
  530.                     Month := GetInt;
  531.                  End;
  532.        _DDYYMM : Begin
  533.                     Day   := GetInt;
  534.                     Year  := GetInt;
  535.                     Month := GetInt;
  536.                  End;
  537.        _MMYYDD : Begin
  538.                     Month := GetInt;
  539.                     Year  := GetInt;
  540.                     Day   := GetInt;
  541.                  End;
  542.    End;
  543.    If Year < 100 Then
  544.       Year := Year + 1900;
  545.    AJDate := JulianDate (Day,Month,Year);
  546. End;
  547. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  548.  
  549. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  550. {▐                   ╔══════════════════════════════════╗                   ▌}
  551. {▐                   ║        D a t e T o d a y         ║                   ▌}
  552. {▐                   ╚══════════════════════════════════╝                   ▌}
  553. {▐══════════════════════════════════════════════════════════════════════════▌}
  554. {▐ Returns a string containing todays date.                                 ▌}
  555. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  556. Function DateToday : String;
  557. Var Year,Month,Day,DayOfWeek : Word;
  558.     TempDate                 : String;
  559. Begin
  560.    GetDate (Year,Month,Day,DayOfWeek);
  561.    DateToStr (Day,Month,Year,TempDate,True,False,'-',1);
  562.    DateToday := TempDate;
  563. End;
  564. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  565.  
  566. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  567. {▐                   ╔══════════════════════════════════╗                   ▌}
  568. {▐                   ║      S D a t e C o m p a r e     ║                   ▌}
  569. {▐                   ╚══════════════════════════════════╝                   ▌}
  570. {▐══════════════════════════════════════════════════════════════════════════▌}
  571. {▐ This function compares to date strings and returns:                      ▌}
  572. {▐                     -1)  If date1 is before date2                        ▌}
  573. {▐                      0)  If date1 is equal to date 2                     ▌}
  574. {▐                      1)  If date1 is after date                          ▌}
  575. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  576. Function SDateCompare (Date1,Date2 : String; Format1,Format2 : Integer;
  577.                        TwoDigitYear1,TwoDigitYear2 : Boolean) : Integer;
  578. Var JDate1 : JDate;
  579.     JDate2 : JDate;
  580. Begin
  581.    StrToJDate (Date1,JDate1,Format1,TwoDigitYear1);
  582.    StrToJDate (Date2,JDate2,Format2,TwoDigitYear2);
  583.    If JDate1 < JDate2 Then
  584.       SDateCompare := -1
  585.    Else
  586.       If JDate1 = JDate2 Then
  587.          SDateCompare := 0
  588.       Else
  589.          SDateCompare := 1;
  590. End;
  591. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  592.  
  593. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  594. {▐                   ╔══════════════════════════════════╗                   ▌}
  595. {▐                   ║         S D a t e D i f f        ║                   ▌}
  596. {▐                   ╚══════════════════════════════════╝                   ▌}
  597. {▐══════════════════════════════════════════════════════════════════════════▌}
  598. {▐ This function returns the number of days between two dates.              ▌}
  599. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  600. Function  SDateDiff (Date1,Date2 : String; Format1,Format2 : Integer;
  601.                      TwoDigitYear1,TwoDigitYear2 : Boolean) : LongInt;
  602. Var JDate1 : JDate;
  603.     JDate2 : JDate;
  604. Begin
  605.    StrToJDate (Date1,JDate1,Format1,TwoDigitYear1);
  606.    StrToJDate (Date2,JDate2,Format2,TwoDigitYear2);
  607.    SDateDiff := JDate1 - JDate2;
  608. End;
  609. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  610.  
  611. Begin
  612. End.
  613. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█▀▀▀▀▀▀▀▀▀▀▀▀▌ }
  614. {▐              █   M o d i f i c a t i o n    H i s t o r y   █            ▌ }
  615. {▐              █▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄█            ▌ }
  616. {▐ ┌────────┐┌─────────────────────────────────────────────────────────────┐▌ }
  617. {▐ │  Date  ││                 Description of Modification                 │▌ }
  618. {▐ ├────────┤├─────────────────────────────────────────────────────────────┤▌ }
  619. {▐ │02/07/92││ Started writing this code.                                  │▌ }
  620. {▐ │02/10/92││ Finished debugging, and wrapped up commenting               │▌ }
  621. {▐ │02/21/92││ Added:   Procedure DateToStr                                │▌ }
  622. {▐ │        ││          Procedure StrToDate                                │▌ }
  623. {▐ │06/16/92││ Added:   Function  DateToday                                │▌ }
  624. {▐ │06/25/92││ Added:   Function  SDateCompare                             │▌ }
  625. {▐ │        ││          Function  SDateDiff                                │▌ }
  626. {▐ └────────┘└─────────────────────────────────────────────────────────────┘▌ }
  627. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌ }